home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / 1svga / apply.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-27  |  2.7 KB  |  78 lines
  1. { AsciiTable, Calendar }
  2.  
  3. uses Txt;
  4.  
  5. { ─────────────── AsciiTable ─────────────── }
  6. procedure Ascii(X,Y:integer);    { 35x19 }
  7. var A,B,K:integer;
  8.     St:string[3];
  9. begin
  10.   TextWindow1(X,Y,35,19,$3E,$3F,1,' ASCII Table ');
  11.   for A:=0 to 15 do for B:=0 to 15 do
  12.     PrintText(X+2*B+2,Y+A+2,$30,Chr(16*A+B));
  13.   A:=0; B:=0;
  14.   repeat
  15.     PrintText(X+2,Y+1,$3F,Chr(16*A+B));
  16.     Str(16*A+B:3,St); PrintText(X+30,Y+1,$3F,St);
  17.     PrintText(X+2*B+1,Y+A+2,$1F,' '+Chr(16*A+B)+' ');
  18.     K:=Key;
  19.     PrintText(X+2*B+1,Y+A+2,$30,' '+Chr(16*A+B)+' ');
  20.     case K of
  21.       $4B00:Dec(B);   $4D00:Inc(B);    { Left, Right }
  22.       $4800:Dec(A);   $5000:Inc(A);    { Up, Down }
  23.       $4900:Dec(A,4); $5100:Inc(A,4);  { PgUp, PgDn }
  24.       $4700:begin A:=0; B:=0; end;     { Home }
  25.       $4F00:begin A:=15; B:=15; end;   { End }
  26.     end;
  27.     if A<0 then A:=15; if A>15 then A:=0;
  28.     if B<0 then B:=15; if B>15 then B:=0;
  29.   until K=$011B;
  30. end;
  31. { ─────────────── Calendar ─────────────── }
  32. procedure Calendar(X,Y:integer);    { 40x10 }
  33. const
  34.   MonthName:array[1..12] of string[9]=(
  35.     'January  ','February ','March    ','April    ','May      ','June     ',
  36.     'July     ','August   ','September','October  ','November ','December ');
  37.   DayName:array[1..7] of string[3]=(
  38.     'Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  39. var Month,Year,Day,Today,I,A,B,K:integer;
  40.     St:string[4];
  41. begin
  42.   TextWindow1(X,Y,40,10,$3E,$3F,1,' Calendar ');
  43.   for I:=1 to 7 do PrintText(X+5*I-2,Y+2,$30,DayName[I]);
  44.   Val(Copy(GetDate,1,4),Year,I);
  45.   Val(Copy(GetDate,6,2),Month,I);
  46.   Val(Copy(GetDate,9,2),Today,I);
  47.   repeat
  48.     Day:=WhichDay(Year,Month,1);
  49.     PrintText(X+3,Y+1,$3F,MonthName[Month]);
  50.     Str(Year:4,St); PrintText(X+32,Y+1,$3F,St);
  51.     TextBar(X+1,Y+3,38,5,$31,' ');
  52.     if ((Year and 3=0) and (Year mod 100<>0)) or (Year mod 400=0)
  53.       then MonthDays[2]:=29 else MonthDays[2]:=28;
  54.     for I:=1 to MonthDays[Month] do begin
  55.       Str(I:2,St); A:=(I-1+Day) mod 7; B:=(I-1+Day) div 7;
  56.       if I=Today then PrintText(5*A+X+2,B+Y+3,$1F,' '+St+' ')
  57.     else if A>0 then PrintText(5*A+X+3,B+Y+3,$31,St)
  58.     else PrintText(5*A+X+3,B+Y+3,$34,St);
  59.     end;
  60.     K:=Key;
  61.     case K of
  62.       $4B00:Dec(Month);   $4D00:Inc(Month);    { Left, Right }
  63.       $4800:Dec(Year);    $5000:Inc(Year);     { Up, Down }
  64.       $4900:Dec(Year,50); $5100:Inc(Year,50);  { PgUp, PgDn }
  65.       $4700:Year:=1;      $4F00:Year:=9999;    { Home, End }
  66.     end;
  67.     if Month<1 then begin Month:=12; Dec(Year); end;
  68.     if Month>12 then begin Month:=1; Inc(Year); end;
  69.     if Year<1 then Year:=1; if Year>9999 then Year:=9999;
  70.   until K=$011B;
  71. end;
  72.  
  73. begin
  74.   TextBar(1,1,80,25,$1B,' ');
  75.   Ascii(30,3);
  76.   Calendar(10,6);
  77. end.
  78.